perm filename CHS1.F4[1,VDS]1 blob
sn#098022 filedate 1974-04-17 generic text, type C, neo UTF8
COMMENT ā VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE DIGIT
C00006 00003 SUBROUTINE DECPT
C00008 ENDMK
Cā;
SUBROUTINE DIGIT
C DATE OF LAST CHANGE - 740317
IMPLICIT INTEGER (A-Z)
LOGICAL EEX, DP, FIXFLG
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (.NOT.EEX) GO TO 1
D(15)=D(16)
D(16)=CODE
RETURN
1 IF (L.GT.13) GO TO 2
IF (M.LE.13) GO TO 3
2 IF (.NOT.DP) CALL EXPON (D(14),D(15),D(16),1)
RETURN
3 IF (.NOT.FIXFLG) GO TO 4
IF (.NOT.DP) GO TO 10
4 M=M+1
D(M)=CODE
5 IF (DP) GO TO 6
IF (L.EQ.1) GO TO 7
CALL EXPON (X(1,15),X(1,16),X(1,17),1)
GO TO 8
6 IF (L.NE.1) GO TO 8
CALL EXPON (X(1,15),X(1,16),X(1,17),-1)
7 IF (CODE.EQ.0) RETURN
8 L=L+1
X(1,L)=CODE
9 RETURN
10 IF (M.NE.1) GO TO 12
D(2)=10
D(3)=11
DO 11 I=1,FIX
11 D(I+3)=10
D(FIX+3)=CODE
M=1
W(1)=2
IF (CODE.EQ.0) RETURN
L=2
X(1,2)=CODE
X(1,15)=13
X(1,17)=FIX
RETURN
12 M=M+1
IF (M.LE.FIX+1) GO TO 14
IF (M.LE.FIX+2) GO TO 13
D(2)=D(4)
COUNT=FIX
GO TO 15
13 J=W(1)
D(J)=D(J+1)
W(1)=W(1)+1
D(M)=CODE
GO TO 5
14 COUNT=FIX-1
15 K=4
16 D(K)=D(K+1)
K=K+1
COUNT=COUNT-1
IF (COUNT.NE.0) GO TO 16
D(FIX+3)=CODE
GO TO 5
END
SUBROUTINE DECPT
C DATE OF LAST CHANGE - 740404
IMPLICIT INTEGER (A-Z)
LOGICAL EEX, DP, FIXFLG
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (EEX) GO TO 5
IF (.NOT.DP) GO TO 1
OP(1)=50
CALL ENTRUP (&4)
GO TO 3
1 DP=.TRUE.
IF (.NOT.FIXFLG) GO TO 3
COUNT=FIX
2 J=W(1)
D(J)=D(J+1)
W(1)=W(1)+1
COUNT=COUNT-1
IF (COUNT.NE.0) GO TO 2
CALL EXPON (X(1,15),X(1,16),X(1,17),FIX)
3 M=M+1
D(M)=11
4 RETURN
5 EEX=.FALSE.
RETURN
END